home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / tensi / 16edit5.bas next >
BASIC Source File  |  1993-11-30  |  21KB  |  291 lines
  1. 10 '16EDIT 制作 元内康博  Ｖｅｒ　５．００　１１月２９日－１２月１４日
  2. 20 ' １９９３年２月２２日－２月２７日　
  3. 30 ' 　天使の筆(１９９３年７月３０日改名)
  4. 40 SCREEN@0:SCREEN 1,0,3,1:SCREEN@0:WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479):SCREEN 1,1:SCREEN@0:WINDOW(0,0)-(639,511):VIEW(0,0)-(639,511):CLS
  5. 50 CLEAR ,,,,,0:DEFINT A-Z:DIM PL(2,15),PIC(76800),WX(9),W2X(9),W2Y(9),WY(9),WC(9),CO(1),OP(9):MOUSE 0,1:MOUSE 1,100,100,1:LP=1:CO(0)=15:CO(1)=0:CDC=0:DEF FONT"システム   16ﾄﾞｯﾄ":LPX=16
  6. 60 DIM ICP1(79),ICP2(31),ICP3(111),ICP4(63),ICP5(191),ICP6(63)
  7. 70 'TITLE
  8. 80 VR$="Ｖｅｒ　５．１５Ｂ":V2$="－１９９３年８月２０日"
  9. 90 SCREEN 1,1,2:WC=0:WX(0)=150:WY(0)=150:GOSUB *E6
  10. 100 LOAD@"TENSI.TIF",(0,480):GET@(0,480)-(79,495),ICP1,0:GET@(80,480)-(111,495),ICP2,0:GET@(112,480)-(222,495),ICP3,0:GET@(223,480)-(286,495),ICP4,0:GET@(287,480)-(478,495),ICP5,0:GET@(479,480)-(542,495),ICP6,0
  11. 110 FOR A=0 TO 1:READ OP(A):NEXT:DATA 16,15
  12. 120 FOR A=0 TO 15:READ PL(0,A),PL(1,A),PL(2,A):NEXT:FOR G=0 TO 1:SCREEN 1,G,3:FOR A=0 TO 15:PALETTE A,[PL(0,A),PL(1,A),PL(2,A)]:NEXT:NEXT
  13. 130 CLS:GOSUB *W1:GOTO *MAIN
  14. 140 DATA 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,64,64,64,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255
  15. 150 *W1
  16. 160 CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,0:SCREEN 1,1:LINE(0,0)-(639,15),PSET,%7,BF:LINE(0,0)-(145,15),PSET,%8,BF:SYMBOL(3,0),"天使の筆 Ver5.15B",1,1,%15
  17. 170 LINE(150,0)-(229,15),PSET,7,BF:PUT@(150,0)-(229,15),ICP1,,%8
  18. 180 LINE(608,0)-(639,15),PSET,7,BF:PUT@(608,0)-(639,15),ICP2,,%8:MOUSE 1,,,1:RETURN
  19. 190 *E1
  20. 200 CX=WX(WC):CY=WY(WC):SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1),PIC:SCREEN 1,1:LINE(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1),PSET,7,B,&H7777:LINE(CX,CY)-(CX+215,CY+247),PSET,%8,BF,7
  21. 210 PUT@A(CX+12,CY+28)-(CX+11+LP*16,CY+27+LP*16),PIC,,12/LP,12/LP:LINE(CX+11,CY+27)-(CX+202,CY+220),PSET,%8,B
  22. 220 SYMBOL(CX,CY+116),"←",.7!,1,%8:SYMBOL(CX+202,CY+116),"→",.7!,1,%8
  23. 230 SYMBOL(CX+100,CY+16),"↑",1,.7!,%8:SYMBOL(CX+100,CY+220),"↓",1,.7!,%8:LINE(CX+5+(LP-1)*32,CY+232)-(CX+36+(LP-1)*32,CY+247),PSET,2,BF
  24. 240 LINE(CX,CY+16)-(CX+215,CY+16),PSET,%8:SYMBOL(CX+20,CY),"ＬＵＰＥ",1,1,%8:SYMBOL(CX+5,CY+232),"１６３２４８複塗潰",1,1,%8:FOR A=0 TO 2:LINE(CX+5+A*32,CY+232)-(CX+37+A*32,CY+248),PSET,%8,B:NEXT
  25. 250 LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%8,BF:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%7:RETURN
  26. 260 *E2
  27. 270 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+102,CY+89),PSET,%8,BF,7:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%8,BF:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%7:LINE(CX,CY+16)-(CX+101,CY+16),PSET,%8
  28. 280 SYMBOL(CX+20,CY+1),"カラー",1,1,%8:FOR G1=0 TO 1:FOR G=0 TO 7:LINE(CX+4+G*12,CY+32+G1*12)-(CX+16+G*12,CY+44+G1*12),PSET,%8,BF,%(G+G1*8):NEXT:NEXT
  29. 290 FOR G=0 TO 1:LINE(CX+6+G*48,CY+18)-(CX+41+G*48,CY+30),PSET,%7,BF,%CO(G):NEXT
  30. 300 FOR G=0 TO 2:LINE(CX+5,CY+58+G*10)-(CX+93,CY+66+G*10),PSET,3-G-(G=0),BF:LINE(CX+6+PL(G,CO(0))/3,CY+59+G*10)-(CX+8+PL(G,CO(0))/3,CY+65+G*10),PSET,%8,B:NEXT
  31. 310 RETURN
  32. 320 *E3
  33. 330 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+111,CY+31),PSET,%8,BF,7:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%8,BF:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%7:SYMBOL(CX+20,CY),"ファイル",1,1,%8
  34. 340 PUT@(CX,CY+16)-(CX+111,CY+31),ICP3,,%8:RETURN
  35. 350 *E4
  36. 360 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+69,CY+31),PSET,%8,BF,7:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%8,BF:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%7:SYMBOL(CX+20,CY),"その他",1,1,%8
  37. 370 PUT@(CX,CY+16)-(CX+63,CY+31),ICP6,,%8:RETURN
  38. 380 *E5
  39. 390 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+191,CY+31),PSET,%8,BF,7:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%8,BF:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%7:SYMBOL(CX+20,CY),"編集",1,1,%8
  40. 400 PUT@(CX,CY+16)-(CX+191,CY+31),ICP5,,%8:RETURN
  41. 410 *E6
  42. 420 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+319,CY+99),PSET,%8,BF,7:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%8,BF:LINE(CX+2,CY+1)-(CX+16,CY+15),PSET,%7
  43. 430 SYMBOL(CX+30,CY+10),"天使の筆　"+VR$,1,1,%8:SYMBOL(CX+30,CY+30),"制作期間　１９９２年１１月２９日",1,1,%8:SYMBOL(CX+130,CY+50),V2$,1,1,%8:SYMBOL(CX+30,CY+70),"制作者  元内康博（１７歳）",1,1,%8
  44. 440 RETURN
  45. 450 *G1
  46. 460 FOR G=8 TO 0 STEP -1:WC(G+1)=WC(G):WX(G+1)=WX(G):WY(G+1)=WY(G):W2X(G+1)=W2X(G):W2Y(G+1)=W2Y(G):NEXT
  47. 470 FOR G=0 TO 8:IF WC(G)=CC THEN FOR G1=G TO 8:WC(G1)=WC(G1+1):WX(G1)=WX(G1+1):WY(G1)=WY(G1+1):W2X(G1)=W2X(G1+1):W2Y(G1)=W2Y(G1+1):NEXT:WC(G1)=0
  48. 480 NEXT:IF WC(G)=CC THEN WC(GG)=0
  49. 490 WC(0)=CC:RETURN
  50. 500 *G2
  51. 510 IF WC>0 THEN SWAP WX(WC),WX(0):SWAP WY(WC),WY(0):SWAP W2X(WC),W2X(0):SWAP W2Y(WC),W2Y(0):SWAP WC(WC),WC(0):WC=0:GOSUB *表示
  52. 520 SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1),PIC:SCREEN 1,1:PUT@A(WX(WC)+12,WY(WC)+28)-(WX(WC)+11+LP*16,WY(WC)+27+LP*16),PIC,,12/LP,12/LP:LINE(WX(WC)+1,WY(WC)+17)-(WX(WC)+99,WY(WC)+26),PSET,7,BF:RETURN *MAIN
  53. 530 *MAIN
  54. 540 SCREEN 1,1
  55. 550 CX=MOUSE(0):CY=MOUSE(1):C1=MOUSE(2,0):C2=MOUSE(2,1)
  56. 560 IF C1=0 AND C2=0 THEN 550
  57. 570 IF C1=-1 THEN C1=0 ELSE C1=1
  58. 580 IF CY<16 AND CX<145 THEN CC=6:GOSUB *G1:WX(0)=150:WY(0)=150:WC=0:GOSUB *E6:W2Y(0)=100:W2X(0)=310:GOTO *MAIN
  59. 590 IF CY<16 AND CX>623 THEN BEEP:SE$="天使の筆を終了していいですか":GOSUB *YN ELSE 610
  60. 600 IF QC=1 THEN END ELSE GOSUB *W1:GOSUB *表示
  61. 610 IF CY<16 AND CX<624 AND CX>608 THEN SCREEN 1,1:CLS ELSE 630
  62. 620 IF MOUSE(2,0)=-1 THEN 620 ELSE GOSUB *W1:GOSUB *表示
  63. 630 IF CY<16 AND CX>150 THEN WAIT 20:CX=INT((CX-150)/16):ON CX+1 GOTO 2860,2730,2840,2900,2880
  64. 640 WC=0 
  65. 650 IF WX(WC)<CX AND WY(WC)<CY AND WX(WC)+W2X(WC)>CX AND WY(WC)+W2Y(WC)>CY THEN 670
  66. 660 WC=WC+1:IF WC>9 THEN 550 ELSE 650
  67. 670 WC1=0:IF WC>0 THEN SWAP WX(WC),WX(0):SWAP WY(WC),WY(0):SWAP W2X(WC),W2X(0):SWAP W2Y(WC),W2Y(0):SWAP WC(WC),WC(0):SWAP WX(WC),WX(1):SWAP WY(WC),WY(1):SWAP W2X(WC),W2X(1):SWAP W2Y(WC),W2Y(1):SWAP WC(WC),WC(1):WC=0:WC1=1
  68. 680 IF NOT(WX(WC)<CX AND WY(WC)<CY AND WX(WC)+W2X(WC)>CX AND WY(WC)+16>CY) THEN 790
  69. 690 ' ｳｨﾝﾄﾞｳ移動
  70. 700 IF WX(0)+16>CX AND WY(0)+16>CY THEN FOR G=1 TO 9:WC(G-1)=WC(G):WX(G-1)=WX(G):WY(G-1)=WY(G):W2X(G-1)=W2X(G):W2Y(G-1)=W2Y(G):NEXT:WC(9)=0:GOSUB *表示:GOTO *MAIN
  71. 710 MC=0:SCREEN 1,1:CCY=CY-WY(0):CCX=CX-WX(0)
  72. 720 CX=MOUSE(0)-CCX:CY=MOUSE(1)-CCY:IF MOUSE(2,0)=-1 THEN MC=0 ELSE MC=MC+1
  73. 730 IF CY<20 THEN CY=20
  74. 740 IF MC=3 THEN WX(0)=CX:WY(0)=CY ELSE LINE(CX,CY)-(CX+W2X(0),CY+W2Y(0)),XOR,7,B:WAIT 2:LINE(CX,CY)-(CX+W2X(0),CY+W2Y(0)),XOR,7,B:GOTO 720
  75. 750 WX(0)=CX:WY(0)=CY:IF WX(0)+W2X(0)>639 THEN WX(0)=639-W2X(0)
  76. 760 IF WY(0)+W2Y(0)>479 THEN WY(0)=479-W2Y(0)
  77. 770 GOSUB *表示:GOTO *MAIN
  78. 780 ' ｳｨﾝﾄﾞｳの命令
  79. 790 CCX=CX-WX(WC):CCY=CY-WY(WC):IF WC1=1 THEN GOSUB *表示
  80. 800 ON WC(WC) GOTO *ルーペ,1150,1230,2210,1790
  81. 810 GOTO *MAIN
  82. 820 *ルーペ
  83. 830 IF CCX>12 AND CCX<201 AND CCY>28 AND CCY<219 THEN CX=INT((CCX-12)/12*LP):CY=INT((CCY-28)/12*LP) ELSE 850
  84. 840 LINE(WX(WC)+12+CX*12/LP,WY(WC)+28+CY*12/LP)-(WX(WC)+11+CX*12/LP+12/LP,WY(WC)+27+CY*12/LP+12/LP),PSET,%CO(C1),BF:SCREEN 1,0:PSET(C1X+CX,C1Y+CY),%CO(C1):GOTO *MAIN
  85. 850 IF CCX>4 AND CCY>232 AND CCX<99 THEN LP=INT((CCX-4)/32)+1:GOSUB *表示::GOTO *MAIN
  86. 860 IF CCX<12 AND CCY>108 AND CCY<140 THEN C1X=C1X-LP*4:C1X=-C1X*(C1X>0):GOSUB *G2
  87. 870 IF CCX>204 AND CCY>108 AND CCY<140 THEN C1X=C1X+LP*4:C1X=-C1X*(C1X<(640-LP*16))-(C1X>639)*600:GOSUB *G2
  88. 880 IF CCX>80 AND CCY>16 AND CCX<120 AND CCY<27 THEN C1Y=C1Y-LP*4:C1Y=-C1Y*(C1Y>0):GOSUB *G2
  89. 890 IF CCX>80 AND CCY>220 AND CCX<120 AND CCY<231 THEN C1Y=C1Y+LP*4:C1Y=-C1Y*(C1Y<(480-LP*16))-(C1X>479)*400:GOSUB *G2
  90. 900 IF CCY>232 AND CCX>99 THEN CC=INT((CCX-100)/16):SCREEN 1,1:MOUSE 4,WX(WC)+12,WY(WC)+28,WX(WC)+203,WY(WC)+219:C2=12/LP:WINDOW(WX(WC)+12,WY(WC)+28)-(WX(WC)+203,WY(WC)+219):VIEW(WX(WC)+12,WY(WC)+28)-(WX(WC)+203,WY(WC)+219):WAIT 20 ELSE 920
  91. 910 ON CC+1 GOTO 930,1080,930
  92. 920 GOTO *MAIN
  93. 930 CX=INT((MOUSE(0)-WX(WC)-12)/C2):CY=INT((MOUSE(1)-WY(WC)-28)/C2)
  94. 940 LINE(WX(WC)+CX*C2+12,WY(WC)+CY*C2+28)-(WX(WC)+CX*C2+C2+11,WY(WC)+CY*C2+C2+27),XOR,7,B:LINE(WX(WC)+CX*C2+12,WY(WC)+CY*C2+28)-(WX(WC)+CX*C2+C2+11,WY(WC)+CY*C2+C2+27),XOR,7,B
  95. 950 IF MOUSE(2,0)=0 THEN 930 ELSE CCX=CX:CCY=CY:WAIT 20
  96. 960 CX=INT((MOUSE(0)-WX(WC)-12)/C2):CY=INT((MOUSE(1)-WY(WC)-28)/C2)
  97. 970 LINE(WX(WC)+CCX*C2+12+C2/2,WY(WC)+CCY*C2+28+C2/2)-(WX(WC)+CX*C2+C2+11+C2/2,WY(WC)+CY*C2+C2+27+C2/2),XOR,7,B:LINE(WX(WC)+CCX*C2+12+C2/2,WY(WC)+CCY*C2+28+C2/2)-(WX(WC)+CX*C2+C2+11+C2/2,WY(WC)+CY*C2+C2+27+C2/2),XOR,7,B
  98. 980 IF MOUSE(2,1)=-1 THEN 1070
  99. 990 IF MOUSE(2,0)=0 THEN 960
  100. 1000 IF CC=2 THEN 1130
  101. 1010 SCREEN 1,0:GET@A(C1X+CCX,C1Y+CCY)-(C1X+CX,C1Y+CY),PIC:SCREEN 1,1:CCX=ABS(CCX-CX):CCY=ABS(CCY-CY):WAIT 20
  102. 1020 CX=INT((MOUSE(0)-WX(WC)-12)/C2):CY=INT((MOUSE(1)-WY(WC)-28)/C2)
  103. 1030 PUT@A(CX*C2,CY*C2)-(CCX+CX*C2,CY*C2+CCY),PIC,XOR,12/LP,12/LP:PUT@A(CX*C2,CY*C2)-(CCX+CX*C2,CY*C2+CCY),PIC,XOR,12/LP,12/LP
  104. 1040 IF MOUSE(2,1)=-1 THEN 1070
  105. 1050 IF MOUSE(2,0)=0 THEN 1020
  106. 1060 SCREEN 1,0:PUT@A(C1X+CX,C1Y+CY)-(C1X+CX+CCX,C1Y+CY+CCY),PIC
  107. 1070 SCREEN 1,1:MOUSE 4,0,0,639,479:WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479):GOSUB *表示:GOTO *MAIN
  108. 1080 CX=INT((MOUSE(0)-WX(WC)-12)/C2):CY=INT((MOUSE(1)-WY(WC)-28)/C2)
  109. 1090 LINE(WX(WC)+CX*C2+12,WY(WC)+CY*C2+28)-(WX(WC)+CX*C2+C2+11,WY(WC)+CY*C2+C2+27),XOR,7,B:LINE(WX(WC)+CX*C2+12,WY(WC)+CY*C2+28)-(WX(WC)+CX*C2+C2+11,WY(WC)+CY*C2+C2+27),XOR,7,B
  110. 1100 IF MOUSE(2,1)=-1 THEN 1070
  111. 1110 IF MOUSE(2,0)=0 THEN 1080
  112. 1120 SCREEN 1,0:WINDOW(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1):VIEW(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1):PAINT@(C1X+CX,C1Y+CY),%CO(C1):WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479):GOTO 1070
  113. 1130 SCREEN 1,0:LINE(C1X+CCX,C1Y+CCY)-(C1X+CX,C1Y+CY),PSET,%CO(C1),BF:GOTO 1070
  114. 1140 *カラー
  115. 1150 IF CCX>4 AND CCY>32 AND CCX<99 AND CCY<55 THEN CO(C1)=INT((CCX-4)/12)+INT((CCY-32)/12)*8 ELSE 1180
  116. 1160 IF C1=0 THEN FOR G=0 TO 2:LINE(WX(WC)+5,WY(WC)+58+G*10)-(WX(WC)+93,WY(WC)+66+G*10),PSET,3-G-(G=0),BF:LINE(WX(WC)+6+PL(G,CO(0))/3,WY(WC)+59+G*10)-(WX(WC)+8+PL(G,CO(0))/3,WY(WC)+65+G*10),PSET,%7,B:NEXT
  117. 1170 LINE(WX(WC)+6+C1*48,WY(WC)+18)-(WX(WC)+41+C1*48,WY(WC)+30),PSET,%8,BF,%CO(C1):GOTO *MAIN
  118. 1180 IF CCY>59 AND CCY<89 THEN CC=INT((CCX-5)/5.33!)*16 ELSE 1210
  119. 1190 IF CC>255 THEN CC=255 ELSE IF CC<0 THEN CC=0
  120. 1200 C1=INT((CCY-58)/10):PL(C1,CO(0))=CC:FOR G=0 TO 1:SCREEN 1,G:PALETTE CO(0),[PL(0,CO(0)),PL(1,CO(0)),PL(2,CO(0))]:NEXT:C1=0:GOTO 1160
  121. 1210 GOTO *MAIN
  122. 1220 *ファイル
  123. 1230 MOUSE 1,,,0:CCY=INT(CCX/16)+1:SCREEN 0:CONSOLE 0,24,2:DIR=0
  124. 1240 FOR GP=0 TO 15:PALETTE GP,[PL(0,GP)/4,PL(1,GP)/4,PL(2,GP)/4]:NEXT:PRINT "ドライブ名?";:A$=INPUT$(1):IF A$=CHR$(13) THEN 1530
  125. 1250 IF A$>CHR$(96) AND A$<CHR$(114) THEN A$=CHR$(ASC(A$)-32)
  126. 1260 PRINT A$:IF A$<CHR$(65) OR A$>CHR$(81) THEN 1240
  127. 1270 ON ERROR GOTO *ER1:SHELL A$+":":IF DIR=0 OR CCY=6 THEN FILES"*.*" ELSE IF CCY<4 THEN FILES"*.TIF" ELSE FILES"*.DAT"
  128. 1280 PRINT :PRINT KMID$("     LOAD     SAVE   圧縮SAVEﾊﾟﾚｯﾄSAVEﾊﾟﾚｯﾄLOADMSXﾃﾞｰﾀ3万色変換",CCY*9-8,9)
  129. 1290 PRINT "※注意)";:IF CCY=6 THEN PRINT "ファイル名は拡張子まで★入力して★ください｡" ELSE PRINT "拡張子は入力しないで下さい"
  130. 1300 IF MEM$<>"" THEN PRINT "前回入力したファイル名　";MEM$
  131. 1310 PRINT "命令一覧　CD:ディレクトリを変更　DIR:特定拡張子のみ表示(ON/OFF)":LINE INPUT "ﾌｧｲﾙ or 命令？　";F$:IF LEFT$(F$,2)="CD" THEN SHELL F$:GOTO 1270
  132. 1320 IF F$="DIR" THEN DIR=1-DIR:GOTO 1270
  133. 1330 IF RIGHT$(F$,1)=":" THEN A$=LEFT$(F$,1):GOTO 1250
  134. 1340 IF F$="" THEN 1530
  135. 1350 SCREEN 1,0:MOUSE 0,1:MOUSE 1,200,100,1
  136. 1360 MEM$=F$:GOSUB *明るい:SCREEN 1,0:ON CCY GOTO 1370,1420,1420,1560,1550,1370,1420
  137. 1370 CX=INT(MOUSE(0)/LPX)*LPX:CY=INT(MOUSE(1)/LPX)*LPX:LINE(CX,CY)-(639,479),XOR,7,B:LINE(CX,CY)-(639,479),XOR,7,B:IF MOUSE(2,1)=-1 THEN 1530
  138. 1380 IF MOUSE(2,0)=0 THEN 1370
  139. 1390 ON ERROR GOTO *ER2:SCREEN 1,0:IF CCY=1 THEN LOAD@ F$+".TIF",(CX,CY):ON ERROR GOTO 0:GOTO 1530
  140. 1400 LOAD@ F$,PIC:PUT@A(CX,CY)-(CX+PIC(0)-1,CY+PIC(1)-1),PIC,,,,,2
  141. 1410 FOR G2=CX TO CX+PIC(0) STEP 2:GET@A(G2,CY)-(G2,CY+PIC(1)),PIC:GET@A(G2+1,CY)-(G2+1,CY+PIC(1)),PIC,500:PUT@A(G2+1,CY)-(G2+1,CY+PIC(1)),PIC:PUT@A(G2,CY)-(G2,CY+PIC(1)),PIC,,,,,500:NEXT:GOTO 1530
  142. 1420 CX=INT((MOUSE(0)+1)/LPX)*LPX-1:CY=INT((MOUSE(1)+1)/LPX)*LPX-1:LINE(0,0)-(CX,CY),XOR,7,B:LINE(0,0)-(CX,CY),XOR,7,B
  143. 1430 IF MOUSE(2,1)=-1 THEN *MAIN
  144. 1440 IF MOUSE(2,0)=0 THEN 1420
  145. 1450 IF CCY=7 THEN 1490
  146. 1460 IF CCY=3 THEN 1540
  147. 1470 MOUSE 1,,,0:SCREEN 1,0:ON ERROR GOTO *ER3:SAVE@ A$+":"+F$+".TIF",(0,0)-(CX,CY):GOTO 1530
  148. 1480 '★３万色変換
  149. 1490 SCREEN 1,1:SCREEN @1:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF
  150. 1500 FOR Y=0 TO CY STEP 2:FOR X=0 TO CX STEP 2:G=0:R=0:B=0:CC!=INT(X/2)+Y*512:FOR A=0 TO 1:C1=PEEK([&H1C]CC!+A*512)
  151. 1510 C3=INT(C1/16):C4=INT(C1-C3*16):G=G+PL(0,C3)+PL(0,C4):R=R+PL(1,C3)+PL(1,C4):B=B+PL(2,C3)+PL(2,C4):NEXT:G=INT(G/4):G=-G*(G<255)-255*(G>254):R=INT(R/4):R=-R*(R<255)-255*(R>254):B=INT(B/4):B=-B*(B<255)-255*(B>254)
  152. 1520 PSET(INT(X/2),INT(Y/2)),[G,R,B]:NEXT:NEXT:SAVE@ A$+":"+F$+".TIF",(0,0)-(INT(CX/2),INT(CY/2)),,1:SCREEN @0:GOTO 1530
  153. 1530 ON ERROR GOTO 0:GOSUB *明るい:SCREEN 1,1:SCREEN@0:MOUSE 0,1:MOUSE 1,100,100,1:CONSOLE 0,24,0:GOSUB *表示:GOSUB *W1:GOTO *MAIN
  154. 1540 MOUSE 1,,,0:SCREEN 1,0:ON ERROR GOTO *ER3:SAVE@ A$+":"+F$+".TIF",(0,0)-(CX,CY),,1:GOTO 1530
  155. 1550 ON ERROR GOTO *ER4:OPEN "I",#1,A$+":"+F$+".DAT":FOR A=0 TO 15:INPUT #1,PL(0,A),PL(1,A),PL(2,A):NEXT:CLOSE #1:GOTO 1530
  156. 1560 ON ERROR GOTO *ER5:OPEN "O",#1,A$+":"+F$+".DAT":FOR A=0 TO 15:PRINT #1,PL(0,A),PL(1,A),PL(2,A):NEXT:CLOSE #1:GOTO 1530
  157. 1570 *ER1
  158. 1580 BEEP:PRINT "ファイル又は 指定のドライブが存在しません｡":IF CCY=1 OR CCY=5 OR CCY=6 THEN DIR=0:RESUME 1270 ELSE RESUME 1290
  159. 1590 *ER2
  160. 1600 BEEP:SCREEN 0:IF ERR=63 THEN PRINT "指定のファイルは存在しません｡":RESUME 1240
  161. 1610 IF ERR=112 THEN PRINT "このツールではこのファイルは読み込めません｡":RESUME 1240
  162. 1620 IF ERR=60 THEN PRINT "ディスクを正しくセットして下さい｡":RESUME 1240
  163. 1630 PRINT "エラー番号";ERR;"が発生しました｡":A$=INPUT$(1):RESUME 1240
  164. 1640 *ER3 
  165. 1650 BEEP:GOSUB *暗い:SCREEN 0:IF ERR<>64 THEN 1700
  166. 1660 PRINT "指定のファイルは存在していますがどうしますか｡":PRINT "1)ＳＡＶＥする 2)その絵を見る 3)中止する"
  167. 1670 Q$=INPUT$(1):CC=VAL(Q$):IF CC=0 OR CC>3 THEN 1660
  168. 1680 IF CC=2 THEN SCREEN 1,1,2:LOAD@ F$+".TIF":Q$=INPUT$(1):SCREEN 0:GOTO 1660
  169. 1690 SCREEN 1,0,3:IF CC=1 THEN KILL A$+":"+F$+".TIF":RESUME ELSE RESUME 1530
  170. 1700 IF ERR=60 THEN PRINT "ディスクを正しくセットして下さい":RESUME 1240
  171. 1710 PRINT "エラー番号";ERR;"が";ERL;"行で発生しました｡":A$=INPUT$(1):RESUME 1240
  172. 1720 *ER4
  173. 1730 IF ERR=63 THEN PRINT "指定のファイルは存在しません｡":RESUME 1230
  174. 1740 GOTO 1710
  175. 1750 *ER5
  176. 1760 GOSUB *暗い:SCREEN 0:IF ERR=64 THEN PRINT "指定のファイルが存在しています｡" ELSE 1710
  177. 1770 PRINT "1)ＳＡＶＥする 2)中止する":Q$=INPUT$(1):CC=VAL(Q$):IF CC=1 THEN KILL A$+":"+F$+".DAT":RESUME 1560 ELSE RESUME 1530
  178. 1780 *編集
  179. 1790 WAIT 20:CC=INT(CCX/16)+1:CLS:IF CC=3 OR CC=6 OR CC=7 THEN 2120
  180. 1800 CX=INT(MOUSE(0)/LPX)*LPX:CY=INT(MOUSE(1)/LPX)*LPX:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B
  181. 1810 IF MOUSE(2,1)=-1 THEN 2110
  182. 1820 IF MOUSE(2,0)=0 THEN 1800
  183. 1830 CCX=CX:CCY=CY:WAIT 20:IF CC=11 THEN 
  184. 1840 GOSUB *暗い:MOUSE 1,,,0:SCREEN 0:PRINT "出力する文字列を入力してください｡":LINE INPUT A$:GOSUB *明るい:SCREEN 1,0:SYMBOL(CX,CY),A$,1,1,%CO(0):MOUSE 1,,,1:GOTO 2110
  185. 1850 ENDIF
  186. 1860 CX=INT((MOUSE(0)+1)/LPX)*LPX-1:CY=INT((MOUSE(1)+1)/LPX)*LPX-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  187. 1870 IF MOUSE(2,1)=-1 THEN 2110
  188. 1880 IF MOUSE(2,0)=0 THEN 1860
  189. 1890 IF CCX>CX THEN CX=CX+1:CCX=CCX-1:SWAP CCX,CX
  190. 1900 IF CCY>CY THEN CY=CY+1:CCY=CCY-1:SWAP CCY,CY
  191. 1910 SCREEN 1,0:IF CC=4 THEN LINE(CCX,CCY)-(CX,CY),PSET,%CO(C1),BF:GOTO 2110
  192. 1920 IF CC=5 THEN LINE(CCX,CCY)-(CX,CY),PSET,%CO(C1),BF:GOTO 2110
  193. 1930 IF CC=8 THEN 
  194. 1940 MOUSE 1,,,0:CX=CX-CCX:CY=CY-CCY:FOR A=0 TO CX:SCREEN 1,0:GET@A(CCX+A,CCY)-(CCX+A,CCY+CY),PIC:SCREEN 1,1:PUT@A(CCX+CX-A,CCY)-(CCX+CX-A,CCY+CY),PIC:NEXT:GET@A(CCX,CCY)-(CCX+CX,CCY+CY),PIC:SCREEN 1,0:PUT@A(CCX,CCY)-(CCX+CX,CCY+CY),PIC
  195. 1950 MOUSE 1,,,0:GOTO 2110
  196. 1960 ENDIF
  197. 1970 IF CC=9 THEN
  198. 1980 CX=CX-CCX:CY=CY-CCY:CC!=INT((INT((CX+8)/8)*4+1)/2):FOR A=0 TO CY:GET@A(CCX,CCY+A)-(CCX+CX,CCY+A),PIC,CC!*A:NEXT
  199. 1990 FOR A=CY TO 0 STEP -1:PUT@A(CCX,CCY+CY-A)-(CCX+CX,CCY+CY-A),PIC,,,,,CC!*A:NEXT:GOTO 2110
  200. 2000 ENDIF
  201. 2010 IF CC=10 THEN
  202. 2020 CX=CX-CCX:CY=CY-CCY:FOR A=0 TO CX:FOR B=0 TO CY:GET@A(A+CCX,B+CCY)-(A+CCX,B+CCY),PIC:IF PIC(0)=CO(0) THEN PSET(A+CCX,B+CCY),%CO(1)
  203. 2030 NEXT:NEXT:GOTO 2110
  204. 2040 ENDIF
  205. 2050 GET@A(CCX,CCY)-(CX,CY),PIC:CCX=CX-CCX:CCY=CY-CCY:WAIT 20
  206. 2060 CX=INT(MOUSE(0)/LPX)*LPX:CY=INT(MOUSE(1)/LPX)*LPX:PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,XOR:PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,XOR
  207. 2070 IF MOUSE(2,1)=-1 THEN 2110
  208. 2080 IF MOUSE(2,0)=0 THEN 2060
  209. 2090 IF CC=1 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC:GOTO 2060
  210. 2100 IF CC=2 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,MATTE,,,0:GOTO 2060
  211. 2110 GOSUB *W1:GOSUB *表示:GOTO *MAIN
  212. 2120 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN 2110
  213. 2130 IF MOUSE(2,0)=0 THEN 2120
  214. 2140 SCREEN 1,0:WAIT 20:IF CC=3 THEN PAINT@(CX,CY),%CO(C1):GOTO 2110
  215. 2150 CCX=ABS(CX-MOUSE(0))+ABS(CY-MOUSE(1)):CIRCLE(CX,CY),CCX,%CO(C1),,,,,XOR:CIRCLE(CX,CY),CCX,%CO(C1),,,,,XOR
  216. 2160 IF MOUSE(2,1)=-1 THEN 2110
  217. 2170 IF MOUSE(2,0)=0 THEN 2150
  218. 2180 IF CC=6 THEN CIRCLE(CX,CY),CCX,%CO(C1):GOTO 2110
  219. 2190 IF CC=7 THEN CIRCLE(CX,CY),CCX,%CO(C1),,,,F:GOTO 2110
  220. 2200 *その他
  221. 2210 CCY=INT(CCX/16)+1:ON CCY GOTO 2220,2260,2280,2380
  222. 2220 SE$="本当に消去していいんですか？":GOSUB *YN:IF QC=0 THEN GOSUB *W1:GOSUB *表示:GOTO *MAIN
  223. 2230 WAIT 20:SE$="画像はＳＡＶＥされません｡":GOSUB *YN:IF QC=0 THEN 2250
  224. 2240 SCREEN 1,0:CLS
  225. 2250 GOSUB *W1:GOSUB *表示:GOTO *MAIN
  226. 2260 ON ERROR GOTO *ER6:CDC=1-CDC:IF CDC=1 THEN CD PLAY ELSE CD STOP
  227. 2270 ON ERROR GOTO 0:GOTO *MAIN
  228. 2280 LINE(50,50)-(500,150),PSET,7,BF:LINE(52,51)-(66,65),PSET,%8,BF:LINE(52,51)-(66,65),PSET,%7:SYMBOL(66,50),"オプションの指定",1,1,%8:MOUSE 4,50,50,500,150
  229. 2290 SYMBOL(55,70),"範囲(場所)指定のサイズ",1,1,%8:SYMBOL(55,86),"アニメーションの間隔",1,1,%8:FOR A=0 TO 1:SYMBOL(410,70+A*16),"↓↑",1,1,%8:NEXT
  230. 2300 MOUSE 1,,,0:LINE(450,70)-(499,149),PSET,7,BF:FOR A=0 TO 1:SYMBOL(450,70+A*16),STR$(OP(A)),1,1,%8:NEXT:MOUSE 1,,,1:WAIT 1
  231. 2310 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,0)=-1 AND CX<65 AND CY<65 THEN MOUSE 4,0,0,639,479:LPX=OP(0):GOSUB *W1:GOSUB *表示:GOTO *MAIN
  232. 2320 IF MOUSE(2,0)=0 THEN WAIT 5:GOTO 2310
  233. 2330 IF CX>410 AND CX<442 AND CY>70 AND CY<102 THEN 2340 ELSE 2310
  234. 2340 CY=INT((CY-70)/16):CX=INT((CX-410)/16)*2-1:OP(CY)=OP(CY)+CX:IF OP(CY)<1 THEN OP(CY)=1
  235. 2350 IF OP(CY)>128 THEN OP(CY)=128
  236. 2360 GOTO 2300
  237. 2370 *ｱﾆﾒ
  238. 2380 SCREEN 1,1:CLS:A$="アニメーションの範囲指定":SYMBOL(50,50),A$+"１",1,1,7:WAIT 20
  239. 2390 CX=INT(MOUSE(0)/LPX)*LPX:CY=INT(MOUSE(1)/LPX)*LPX:LINE(CX,CY)-(CX+LPX,CY+LPX),XOR,7,B:LINE(CX,CY)-(CX+LPX,CY+LPX),XOR,7,B:IF MOUSE(2,1)=-1 THEN 2250
  240. 2400 IF MOUSE(2,0)=0 THEN 2390
  241. 2410 CCX=CX:CCY=CY:WAIT 20
  242. 2420 CX=INT((MOUSE(0)+1)/LPX)*LPX-1:CY=INT((MOUSE(1)+1)/LPX)*LPX-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:WAIT 1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN 2250
  243. 2430 IF MOUSE(2,0)=0 THEN 2420
  244. 2440 SCREEN 1,0:C1X=CCX:C1Y=CCY:CCX=CX-CCX:CCY=CY-CCY:GET@A(C1X,C1Y)-(C1X+CCX,C1Y+CCY),PIC:CC!=INT((INT((CCX+8)/8)*(CCY+1)*4+1)/2):IF CC!>38400 THEN 2380
  245. 2450 C=2
  246. 2460 SCREEN 1,1:CLS:SYMBOL(50,50),A$+STR$(C),1,1,7:WAIT 20
  247. 2470 CX=INT(MOUSE(0)/LPX)*LPX:CY=INT(MOUSE(1)/LPX)*LPX:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:WAIT 1:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IF MOUSE(2,1)=-1 THEN IF C>2 THEN 2500 ELSE 2250
  248. 2480 IF MOUSE(2,0)=0 THEN 2470
  249. 2490 CLS:SCREEN 1,0:GET@A(CX,CY)-(CX+CCX,CY+CCY),PIC,CC!*(C-1):SCREEN 1,1:IF CC!*(C+1)<76800 THEN C=C+1:GOTO 2460
  250. 2500 C=C-1:WAIT 20:C2X=INT((CCX+1)/2):C2Y=INT((CCY+1)/2):LINE(318-C2X,238-C2Y)-(320+C2X,240+C2Y),PSET,0,BF,7:C1=0
  251. 2510 PUT@A(320-C2X,240-C2Y)-(319-C2X+CCX,239-C2Y+CCY),PIC,,,,,CC!*C1:IF MOUSE(2,1)=-1 THEN 2250
  252. 2520 WAIT OP(1):C1=C1+1:IF C1>C THEN C1=0
  253. 2530 GOTO 2510
  254. 2540 *ER6
  255. 2550 RESUME *MAIN
  256. 2560 *暗い
  257. 2570 SCREEN 1,0:FOR GP=0 TO 15:PALETTE GP,[PL(0,GP)/4,PL(1,GP)/4,PL(2,GP)/4]:NEXT:RETURN
  258. 2580 *明るい
  259. 2590 FOR GPP=0 TO 1:SCREEN 1,GPP:FOR GP=0 TO 15:PALETTE GP,[PL(0,GP),PL(1,GP),PL(2,GP)]:NEXT:NEXT:RETURN
  260. 2600 *YN
  261. 2610 SCREEN 1,1:LINE(150,150)-(450,250),PSET,0,BF,7:LINE(152,152)-(448,248),PSET,0,B:SYMBOL(160,160),SE$,1,1,%8:LINE(320,220)-(360,240),PSET,0,B:LINE(380,220)-(420,240),PSET,0,B
  262. 2620 SYMBOL(322,222),"実行",1,1,%8:SYMBOL(382,222),"取消",1,1,%8
  263. 2630 CX=MOUSE(0)-320:CY=MOUSE(1)-220
  264. 2640 IF MOUSE(2,0)=0 THEN 2630
  265. 2650 IF CY<0 OR CY>20 THEN 2630
  266. 2660 IF CX>0 AND CX<40 THEN QC=1 ELSE QC=0
  267. 2670 RETURN
  268. 2680 *表示
  269. 2690 MOUSE 1,,,0:SCREEN 1,1:LINE(0,17)-(639,479),PSET,0,BF:FOR G9=9 TO 0 STEP -1:WC=G9:IF WC(WC)=0 THEN 2710
  270. 2700 ON WC(WC) GOSUB *E1,*E2,*E3,*E4,*E5,*E6
  271. 2710 NEXT:MOUSE 1,,,1:RETURN
  272. 2720 'ルーペ
  273. 2730 LINE(0,0)-(639,479),PSET,0,BF:SCREEN 1,0
  274. 2740 CX=INT(MOUSE(0)/LPX)*LPX:CY=INT(MOUSE(1)/LPX)*LPX
  275. 2750 LINE(CX,CY)-(CX+16*LP-1,CY+16*LP-1),XOR,7,B:LINE(CX,CY)-(CX+16*LP-1,CY+16*LP-1),XOR,7,B
  276. 2760 IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOTO *MAIN
  277. 2770 IF MOUSE(2,0)=0 THEN 2740
  278. 2780 CC=1:GOSUB *G1
  279. 2790 C1X=CX:C1Y=CY:WC=0:WX(0)=CX+50:WY(0)=CY+50:IF WY(0)<20 THEN WY(0)=20 ELSE IF WY(0)+248>479 THEN WY(0)=230
  280. 2800 IF WX(0)+216>639 THEN WX(0)=420 
  281. 2810 GOSUB *表示:GOSUB *W1:W2X(0)=216:W2Y(0)=248
  282. 2820 GOTO *MAIN
  283. 2830 'カラー
  284. 2840 CC=2:GOSUB *G1:WX(0)=60:WY(0)=80:WC=0:GOSUB *E2:W2X(0)=102:W2Y(0)=90:GOTO *MAIN
  285. 2850 'ファイル
  286. 2860 CC=3:GOSUB *G1:WX(0)=50:WY(0)=20:WC=0:GOSUB *E3:W2Y(0)=32:W2X(0)=112:GOTO *MAIN
  287. 2870 'その他
  288. 2880 CC=4:GOSUB *G1:WX(0)=500:WY(0)=20:WC=0:GOSUB *E4:W2Y(0)=32:W2X(0)=70:GOTO *MAIN
  289. 2890 '編集
  290. 2900 CC=5:GOSUB *G1:WX(0)=240:WY(0)=20:WC=0:GOSUB *E5:W2Y(0)=32:W2X(0)=191:GOTO *MAIN
  291.